home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
HyperLib 1997 Winter - Disc 1
/
HYPERLIB-1997-Winter-CD1.ISO.7z
/
HYPERLIB-1997-Winter-CD1.ISO
/
オンラインウェア
/
UTIL
/
Alpha 6.5.sit
/
Tcl
/
Modes
/
perl4.tcl
< prev
next >
Wrap
Text File
|
1996-08-15
|
5KB
|
139 lines
if {![info exists perlDocs]} {
set perlDocs "$HOME:Help:Perl Commands"
}
##############################################################################
# Colorization setup
#
# Keywords are separated here according to their location in "Perl Commands",
# for the convenience of the cmd-double-click mechanism.
#
# Expression words are described in the "Compound Statements" section
#
set perlExprWords {
else elsif for foreach if return unless until while eq ne cmp lt gt le ge
}
# Special variables are described in their own section (and are not
# individually marked, so we have to search for them.)
#
# This group can safely be colorized...
#
set perlNameWords {
@_ $_ $. $/ $, $" $¥¥ $¥# $% $= $- $~ $^ $| $$ $? $& $` $' $+ $*
$0 $1 $2 $3 $4 $5 $6 $7 $8 $9 $[ $] $; $! $@ $< $> $( $) $:
}
#... while this group is forced lower-case by the current colorization scheme
#
set perlSpecialVars [concat $perlNameWords {
$^D $^F $^I $^P $^T $^W $^X
$ARGV @ARGV @INC %INC @INC %ENV $SIG $ENV %SIG
}]
# Perl operators and functions are indexed via the Marks menu
#
set perlKeyWords {
accept alarm atan2 bind binmode caller chdir chmod chop chown chroot
close closedir connect continue cos crypt dbmclose dbmopen defined
delete die do dump each eof eval exec exit exp fcntl fileno
flock fork getc getlogin getpeername getpgrp getppid
getpriority getgrnam gethostbyname getnetbyname getprotobyname getpwuid
getgrgid getservbyname gethostbyaddr getnetbyaddr getprotobynumber
getservbyport getpwent getgrent gethostent getnetent getprotoent
getservent setpwent setgrent sethostent setnetent setprotoent setservent
endpwent endgrent endhostent endnetent endprotoent endservent
getsockname getsockopt gmtime goto grep hex index int ioctl join keys
kill last length link listen local localtime log lstat lstat mkdir
msgctl msgget msgsnd msgrcv next oct open opendir ord pack pipe pop
print printf push q qq qx rand read readdir readlink recv redo
rename require reset reverse rewinddir rindex rindex rmdir
scalar seek seekdir select semctl semget semop send setpgrp setpriority
setsockopt shift shmctl shmget shmread shmwrite shutdown sin sleep
socket socketpair sort splice split sprintf sqrt srand stat study sub
substr symlink syscall sysread system syswrite tell telldir time times
tr truncate umask undef unlink unpack unshift utime values
vec wait waitpid wantarray warn write
}
set perlWords [concat $perlKeyWords $perlNameWords $perlExprWords]
regModeKeywords -e {#} -c red -k blue -s [set PerlmodeVars(stringColor)] Perl $perlWords
unset perlWords
##############################################################################
# Cmd-double-click support for Perl mode.
#
proc PerlDblClick {from to} {
global HOME perlKeyWords perlSpecialVars perlExprWords
global perlSearchPath
set pc [lookAt [expr $from - 1]]
set ppc [lookAt [expr $from - 2]]
set tc [lookAt $to]
# Extend selection to include special characters
#
if {$pc == {$}} {
if {$from == $to} { incr to }
incr from -1
if {$tc == {^}} { incr to }
} elseif {$pc == {^} && $ppc == {$}} {
incr from -2
} elseif {$pc == {%} || $pc == {@}} {
incr from -1
}
# Return if there's no selected text
if {$to > $from} {
select $from $to
set text [getSelect]
set qtext [quoteExpr $text]
} else {
return
}
set perlSearchPath {}
# Function call
if {$pc == "&"} {
if {![catch {search -f 1 -r 1 -m 0 -s "sub *$qtext *¥{" 0} mtch]} {
pushMark
eval select $mtch
message "Use Ctl-. to return to original position"
} else {
message {Sub definition not found}
}
# Look up keywords in the man page by their file marks
} elseif {[lsearch -exact $perlKeyWords $text] >= 0} {
editMark "$HOME:Help:Perl Commands" $text
# Special vars aren't marked, so search for their definitions
} elseif {[lsearch -exact $perlSpecialVars $text] >= 0} {
if {[lsearch -exact [winNames] "Perl Commands"] >= 0} {
bringToFront "Perl Commands"
} else {
edit "$HOME:Help:Perl Commands"
}
if {![catch {search -f 0 -r 0 -m 0 -i 0 -s " $text " [maxPos]} mtch]} {
goto [lindex $mtch 0]
}
# Flow control statements don't have separate entries
} elseif {[lsearch -exact $perlExprWords $text] >= 0} {
editMark "$HOME:Help:Perl Commands" "Compound statements"
# If user clicked the arg of a 'require' command, open the file
} elseif {![catch {perlFindRequire $from $to} filename]} {
openPerlFile $filename
# Other
} else {
select $from $to
message {Command-double-click on keywords, special vars, and req'd filenames}
}
}